Function Main()
	On Error Resume Next
	Dim obtainfolder
	Dim Pathfinder
	Dim strPath

	Set fso = CreateObject("Scripting.FileSystemObject")

	strPath = "C:\Documents and Settings\"

	set excludefile = fso.OpenTextFile("\\bbs-svr-001\rmpublic\scripts\exclude.txt", 1)
	excludelist = excludefile.Readall
	'msgbox excludelist

	Set f = fso.GetFolder(strPath)

	' Loop through all subfolders
	For Each fldrItem in f.SubFolders
	  fldrName = fldrItem.name
	  If Right(strPath,1) <> "\" Then
	    Pathfinder = strPath & "\" & fldrName
	  Else
	    Pathfinder = strPath & fldrName
	  End If

	  If InStr(1, excludelist, fldrName, 1) Then
	    'msgbox "Has not deleted " & fldrName
	  Else
	    'msgbox "Deleting " & fldrName
	    set obtainfolder = fso.GetFolder(Pathfinder)
	    obtainfolder.Delete true
	  End If

  'End Select

	Next

	' Clean up objects
	Set fso = Nothing
	Set fc = Nothing

End Function

call Main()
